home *** CD-ROM | disk | FTP | other *** search
/ Whiteline: Alpha / Whiteline Alpha.iso / progtool / x_lisp / example.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1994-09-22  |  2.5 KB  |  75 lines
  1. ; Make the class ship and its instance variables be known
  2.  
  3. (setq ship (Class :new '(x y xv yv m name captain registry)))
  4.  
  5.  
  6. (ship :answer :getx        '() '( x ))    ; just evaluate x
  7. (ship :answer :getxv        '() '( xv ))    ; note that the method is a
  8. (ship :answer :gety        '() '( y ))    ; list of forms, the value
  9. (ship :answer :getyv        '() '( yv ))    ; of the last one being the
  10. (ship :answer :getm        '() '( m ))    ; value of the method
  11. (ship :answer :getname        '() '( name ))
  12. (ship :answer :getcaptain    '() '( captain ))
  13. (ship :answer :getregistry    '() '( registry ))
  14.  
  15. ;               formal
  16. ;               param
  17. ;               of
  18. ;               method
  19. (ship :answer :setx         '(to) '( (setq x to) ) )
  20. (ship :answer :setxv        '(to) '( (setq xv to) ) )
  21. (ship :answer :sety         '(to) '( (setq y to) ) )
  22. (ship :answer :setyv       '(to) '( (setq yv to) ) )
  23. (ship :answer :setm       '(to) '( (setq m to) ) )
  24. (ship :answer :setname     '(to) '( (setq name to) ) )
  25. (ship :answer :setcaptain  '(to) '( (setq captain to) ) )
  26. (ship :answer :setregistry '(to) '( (setq registry to) ) )
  27.  
  28. (ship :answer :sail '(time) 
  29.     ; the METHOD for sailing
  30.     '( (princ (list "sailing for " time " hours\n"))
  31.        ; note that this form is expressed in terms of objects:  "self"
  32.        ; is bound to the object being talked to during the execution
  33.        ; of its message.  It can ask itself to do things.
  34.        (self :setx (+  (self :getx)
  35.                (* (self :getxv) time)))
  36.        ; This form performs a parallel action to the above, but more
  37.        ; efficiently, and in this instance, more clearly
  38.        (setq y (+ y (* yv time)))
  39.        ; Cute message for return value.  Tee Hee.
  40.        "Sailing, sailing, over the bountiful chow mein..."))
  41.  
  42. ; <OBJECT: #12345667> is not terribly instructive.  How about a more
  43. ; informative print routine?
  44.  
  45. (ship :answer :print '() '((princ (list
  46.                 "SHIP NAME: " (self :getname) "\n"
  47.                 "REGISTRY: " (self :getregistry) "\n"
  48.                 "CAPTAIN IS: " (self :getcaptain) "\n"
  49.                 "MASS IS: " (self :getm) " TONNES\n"
  50.                 "CURRENT POSITION IS: " 
  51.                     (self :getx)    " X BY "
  52.                     (self :gety)    " Y\n"
  53.                 "SPEED IS: "
  54.                     (self :getxv)    " XV BY "
  55.                     (self :getyv)    " YV\n") ) ))
  56.  
  57. ; a function to make life easier
  58.  
  59. (defun newship (mass name registry captain &aux new)
  60.     (setq new (ship :new))
  61.     (new :setx 0)
  62.     (new :sety 0)
  63.     (new :setxv 0)
  64.     (new :setyv 0)
  65.     (new :setm mass)
  66.     (new :setname name)
  67.     (new :setcaptain captain)
  68.     (new :setregistry registry)
  69.     (new :print)
  70.     new)
  71.  
  72. ; and an example object.
  73.  
  74. (setq Bounty (newship 50 'Bounty 'England 'Bligh))
  75.